perm filename FILL.OLD[MSS,LCS] blob sn#096364 filedate 1974-04-05 generic text, type T, neo UTF8
00010		SUBROUTINE FILLER
00110		COMMON /FL/IC,N,NQ,RZ,IXRX,XGP,RXGP
00123		COMMON /RZ/RSZ,IPLT,RJB,CENTR
00136		COMMON /RC/MCLEF(200),IST(4000),MFILL(200)
00150		REAL LF
00200		COMMON Q(200),R(200),E(200),NN
00210		COMMON/LL/L
00600	
01400		KK=0
01490	206	DO 205 J=IC,MCLEF(1)
01500		CALL UNPACK(J,M,N,MCLEF)
01505		KK=KK+1
01510		E(KK)=0
01520		IF(L.LT.100000000)GO TO 208
01521		E(KK)=-1
01522		IF(KK.EQ.1)GO TO 207
01523		E(KK)=-2
01524		Q(KK)=Q(K)
01525		R(KK)=R(K)
01526		KK=KK+1
01527		E(KK)=-1
01528	207	K=KK+1
01530	208	Q(KK)=(M+RJB)*RSZ
01540		R(KK)=(N+CENTR)*RSZ
01541	205	IF(Q(KK).EQ.Q(KK-1))E(KK)=-1
01542		J=KK+1
01545	CC	E(1)=-1
01550		R(J)=R(K)
01555		Q(J)=Q(K)
01560		E(J)=-2
01570	C  ABOVE??? 0 , 1 OR -1 ???
01580		RR=RSZ
01585		IF(IXRX)RR=RR*1.7
01590	C  FOR XGP
01595		RSZ=1
01600		GO TO 201
01690	400	DO 40 K=1,KK
01695		J=2
01700		IF(E(K))J=3
01800	40	CALL LINES(Q(K),R(K),J)
01900	201	N=1
02000	4	J=0
02010		CALL DPYOUT(1)
02100	CC	H=-1000
02200		Z=-1000
02300		DO 1 K=2,KK
02400		IF(E(K).NE.0)GO TO 1
02401		NN=K
02402		RA=R(K-1)
02403		IF(RA.LT.R(K))RA=R(K)
02404		IF(RA.LT.Z)GO TO 1
02412		IF(RA.NE.R(K))NN=K-1
02420		QA=Q(NN)
02430		QB=Q(NN+1)
02440		QC=Q(NN-1)
02450		RB=R(NN+1)
02460	CC	RC=R(NN-1)
02470		ID=-1
02480		IF(QA-QC)ID=0
02490		JD=-1
02500		IF(QA-QB)JD=0
02505		IF(JD.NE.ID .OR. QA.EQ.QB .OR. QA.EQ.QC)GO TO 301
02510	CC	X=((R(NN)-RC)*(QB-QC))/(QA-QC)+RC
02511		X=HGHT(R(NN),R(NN-1),QB,QC,QA)
02520		IF(X.LE.RB)GO TO 303
03200	301	Z=RA
03300	C  FINDS HIGHEST LINE
03400		J=NN
03450		JJ=NN
03500		GO TO 1
03505	303	IF(E(NN+1).EQ.1..OR.E(NN+1).EQ.-2.)GO TO 301
03507		IF(E(NN+1))GO TO 1
03510		Z=RB
03520		IF(R(NN).GT.Z)Z=R(NN)
03530		J=NN+1
03547		JJ=NN
03600	1	CONTINUE
03700	
03800		IF(J.EQ.0)GO TO 10
04000		JA=J-1
04100	C  J = END OF HIGHEST LINE
04200	19	RT=Q(J)
04300		LF=Q(JA)
04400		RJ=R(J)
04500		RJ1=R(JA)
04600	16	E(J)=-1
04610		IF(JJ.NE.J)E(JJ)=1.
04700	C  LINE USED
04800	CC	HT=RJ-RJ1
04900		DIS=RT-LF
04950		M=2
05000		IF(KK.GT.60)M=3
05100	22	IF(DIS)M=-M
05110		X=-1
05155		J=3
05200	
05300	17	DO 2 K=IFIX(LF),IFIX(RT),M
05310		RK=K
05500	CC	Y=(HT*(RK-LF))/DIS+RJ1
05501		Y=HGHT(RJ,RJ1,RK,LF,RT)
05610		IF(X)CALL LINES(RK,Y,J)
05620		J=2
05700		H=-1000
05800	
05900	18	DO 3 I=2,KK
06000		IF(E(I))GO TO 3
06100	C  SKIP IF SAME LINE.
06200		QA=Q(I)
06300		QB=Q(I-1)
06400		IF((QA.GT.RK.AND.QB.GT.RK).OR.(QA.LT.RK.AND.QB.LT.RK))GOTO 3
06500	C  LINE WAS NOT UNDER POINT K
06600	CC	RA=R(I)
06700	CC	RB=R(I-1)
06800	CC	HX=RA-RB
06900	CC	DX=QA-QB
07000	CC	B=(HX*(RK-QB))/DX+RB
07001		B=HGHT(R(I),R(I-1),RK,QB,QA)
07100		IF(B.GT.Y)GO TO 3
07200		IF(B.LE.H)GO TO 3
07300		H=B
07400		IX=I
07500	C  FOUND HIGHEST NEW POINT
07600	3	CONTINUE
07700		IF(H.EQ.Y)GO TO 31
07800	C  WIPES OUT THIS LINE SEG.
07900	30	IF(RK.NE.Q(IX).AND.RK.NE.Q(IX-1))E(IX)=1
08000	C  TOUCHING END OF SEG. DOES NOT COUNT.
08100	
08200		IF(H.EQ.-1000)GO TO 31
08310		CALL LINES(RK,H,J)
08320		IF(X.GT.0)CALL LINES(RK,Y,J)
08330		X=-X
08340		GO TO 2
08350	31	X=1
08500	2	CONTINUE
08600	
08610		GO TO 4
11705	10	CALL DPYOUT(1)
11800		RSZ=RR
12000		END
13000		
13100		FUNCTION HGHT(A,B,C,D,E)
13200		HGHT=((A-B)*(C-D))/(E-D)+B
13300		END